home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Dialogs / DialogGroupBoxes.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-06-30  |  9.0 KB  |  212 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 3 May 95
  6. Syntax10b.Scn.Fnt
  7. Chicago10.Scn.Fnt
  8. MODULE DialogGroupBoxes;
  9. (** Markus Knasm
  10. ller 30 Jun 94 - 
  11. IMPORT DialogFrames, Dialogs, DialogStaticTexts, DialogTexts, Display, Display1, Files, 
  12.     Fonts, GraphicUtils, In, Oberon, Printer, TextFrames, Texts, Viewers;
  13.     CONST W* = 100; H* = 100; black = 15; white = 0; MM = 1; CR = 0DX;
  14.     TYPE
  15.         Item* = POINTER TO ItemDesc;
  16.         ItemDesc* = RECORD(Dialogs.ObjectDesc)
  17.             fnt-: Fonts.Font; (** the font with which the text is shown *)
  18.             s-: ARRAY 64 OF CHAR;  (** the text which is shown *) 
  19.         END;
  20.     VAR w0: Texts.Writer;
  21.     PROCEDURE (g: Item) Draw* (x, y: INTEGER; f: Display.Frame);
  22.     (** displays the object at (x, y) in frame f *)
  23.         VAR mode, w, h, gx, gy, cx, yh: INTEGER;
  24.         PROCEDURE Max (x, y: INTEGER): INTEGER;
  25.         BEGIN
  26.             IF x > y THEN RETURN x ELSE RETURN y END
  27.         END Max;
  28.     BEGIN    
  29.         g.GetDim (gx, gy, w, h); INC (y);
  30.         DEC (w, 2); DEC (h, 5); cx := 0; 
  31.         IF (h < 0) OR (w < 0) THEN 
  32.             Display1.Line (f, black, x, y, x + Max (w, 0), y + Max (h, 0), Display.paint);
  33.             RETURN 
  34.         END;
  35.         IF g.selected THEN mode := Display.invert ELSE mode := Display.paint END;
  36.         yh := y + h - g.fnt.maxY - g.fnt.minY; 
  37.         IF g.s = "" THEN cx := w 
  38.         ELSIF yh > y THEN GraphicUtils.DrawString (f, g.s, x + 3, yh, w - 4, g.fnt, mode, GraphicUtils.center, cx) 
  39.         END;
  40.         Display1.Line (f, black, x, y, x + w, y, mode); Display1.Line (f, black, x, y, x, y + h, mode);
  41.         Display1.Line (f, black, x + w, y, x + w, y + h, mode); 
  42.         Display1.Line (f, white, x, y - 1, x + w, y - 1, mode); Display1.Line (f, white, x + 1, y + 1, x + 1, y + h, mode);
  43.         Display1.Line (f, white, x + w + 1, y, x + w + 1, y + h, mode);
  44.         IF cx > 0 THEN
  45.             Display1.Line (f, black, x, y + h, x + cx, y + h, mode); 
  46.             Display1.Line (f, black, x + w - cx, y + h, x + w, y + h, mode);
  47.             Display1.Line (f, white, x + 1, y + h - 1, x + cx, y + h - 1, mode); 
  48.             Display1.Line (f, white, x + w - cx, y + h - 1, x + w - 1, y + h - 1, mode)
  49.         END;
  50.     END Draw;
  51.     PROCEDURE (g:Item) Print* (x, y: INTEGER);
  52.     (** prints the object at printer coordinates (x, y) *)
  53.         VAR w, h, gx, gy, yh, cx: INTEGER; fnth: LONGINT;
  54.     BEGIN
  55.         g.GetPDim (gx, gy, w, h);
  56.         DEC (w, 2); DEC (h, 5); IF h < 0 THEN RETURN END;
  57.         Printer.Line (x, y, x + w, y); Printer.Line (x, y, x, y + h);
  58.         Printer.Line (x + w, y, x + w, y + h);
  59.         fnth := (g.fnt.maxY + g.fnt.minY) * Dialogs.dUnit DIV Dialogs.pUnit;
  60.         yh := y + h - SHORT (fnth); 
  61.         IF yh > y THEN GraphicUtils.PrintString (g.s, x + 3, yh, w - 4, g.fnt, GraphicUtils.center, cx) END;
  62.         IF cx > 0 THEN
  63.             Printer.Line (x, y + h, x + cx, y + h); Printer.Line (x + w - cx, y + h, x + w, y + h);
  64.         END
  65.     END Print;
  66.     PROCEDURE (g: Item) Copy* (VAR dup: Dialogs.Object);
  67.     (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
  68.         VAR x: Item;
  69.     BEGIN
  70.         IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; 
  71.         g.Copy^ (dup); x.fnt := g.fnt; COPY (g.s, x.s);
  72.     END Copy;
  73.     PROCEDURE (g: Item) Load* (VAR r: Files.Rider);
  74.     (** reads the object from rider r *)
  75.         VAR fntname: ARRAY 32 OF CHAR;
  76.     BEGIN g.Load^ (r); Files.ReadString (r, fntname); g.fnt := Fonts.This (fntname); Files.ReadString (r, g.s) ;
  77.     END Load;
  78.     PROCEDURE (g: Item) Store* (VAR r: Files.Rider);
  79.     (** writes the object to rider r *)
  80.     BEGIN g.Store^ (r); Files.WriteString (r, g.fnt.name); Files.WriteString (r, g.s);
  81.     END Store;
  82.     PROCEDURE (g: Item) SetFont* (fnt: Fonts.Font);
  83.     (** sets the font with which the text is shown *)
  84.     BEGIN g.Hide; g.fnt := fnt; g.Restore; IF g.panel # NIL THEN g.panel.MarkMenu END
  85.     END SetFont;
  86.     PROCEDURE (g: Item) SetString* (s: ARRAY OF CHAR);
  87.     (** sets the text which is shown *)
  88.     BEGIN g.Hide; COPY (s, g.s); g.Restore; IF g.panel # NIL THEN g.panel.MarkMenu END
  89.     END SetString;
  90.     PROCEDURE (g: Item) Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
  91.     (** handles messages which were sent to frame f *)
  92.         VAR t: Texts.Text;
  93.     BEGIN
  94.         g.Handle^ (f, m);
  95.         WITH f: DialogFrames.Frame DO 
  96.             WITH m: Oberon.InputMsg DO
  97.                 IF m.id = Oberon.track THEN 
  98.                     IF (m.keys = {MM}) & (g.cmd[0] # 0X) THEN 
  99.                         DialogTexts.GetParText (g.par, g.panel, t);
  100.                         g.CallCmd (f, Viewers.This (m.X, m.Y), TextFrames.Text ("")) 
  101.                     END
  102.                 ELSE Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, m.X, m.Y)
  103.                 END
  104.             ELSE
  105.             END
  106.         ELSE
  107.         END
  108.     END Handle;
  109.     PROCEDURE WriteToObjectStr (o: DialogTexts.Item; VAR p: Dialogs.Panel; n: ARRAY OF CHAR);
  110.         VAR t: Texts.Text; 
  111.     BEGIN
  112.         t := o.GetText (); Texts.WriteString (w0, n); Texts.Append (t, w0.buf);
  113.     END WriteToObjectStr;
  114.     PROCEDURE (g: Item) Edit*;
  115.     (** opens a dialog for editing the properties of the object *)
  116.         VAR on: Dialogs.Object; os, string: DialogTexts.Item; s: DialogStaticTexts.Item; p: Dialogs.Panel; t1: Texts.Text; fnt: Fonts.Font;
  117.     BEGIN
  118.         g.Edit^ (); p := Dialogs.editPanel;
  119.         NEW (string); string.Init; 
  120.         string.SetName ("string"); string.SetDim (245, -30, 140, 19, FALSE); p.Insert (string, FALSE); 
  121.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  122.         NEW (s); s.Init; s.SetDim (196, -30, 40, 20, FALSE); 
  123.         s.SetString ("String"); fnt := Fonts.This ("Syntax10.Scn.Fnt"); s.SetFont (fnt);
  124.         p.Insert (s, FALSE); 
  125.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  126.         WriteToObjectStr (string, p, g.s); 
  127.         t1 := string.GetText (); Texts.ChangeLooks (t1, 0, t1.len, {0}, g.fnt, 0, 0);
  128.     END Edit;
  129.     PROCEDURE (g: Item) Update* (p: Dialogs.Panel);
  130.     (** sets the properties of the object to the values defined in the dialog p opened with Edit *)
  131.         VAR os: Dialogs.Object; t1: Texts.Text; r: Texts.Reader; ch: CHAR; str: ARRAY 64 OF CHAR; i: INTEGER;
  132.     BEGIN
  133.         g.Update^ (p); 
  134.         os := p.NamedObject ("string"); t1 := os(DialogTexts.Item).GetText ();
  135.         Texts.OpenReader (r, t1, 0); Texts.Read (r, ch); i := 0;
  136.         IF (r.fnt # NIL) & (r.fnt # g.fnt) THEN g.SetFont (r.fnt) END;
  137.         WHILE ~ r.eot DO 
  138.              str[i] := ch; INC (i); Texts.Read (r, ch);
  139.         END;
  140.         str[i] := 0X; 
  141.         IF str # g.s THEN g.SetString (str) END
  142.     END Update;
  143.     PROCEDURE (g: Item) GetObjects* (VAR obArray: ARRAY OF Dialogs.Object; VAR nofelems: INTEGER);
  144.     (** gets all objects which are lying unter the groupbox *)
  145.         VAR p: Dialogs.Panel; x, y, w, h: INTEGER;
  146.     BEGIN
  147.         p := g.panel; g.GetDim (x, y, w, h); p.GetObjects (x, y, w, h, obArray, nofelems);
  148.     END GetObjects;  
  149.     PROCEDURE Insert*;
  150.     (** Insert ([name] [x y w h] | ^ ) inserts a groupbox - item in the panel containing the caret position *)
  151.         VAR x, y, x1, y1, w, h: INTEGER; g: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR; r: Texts.Reader; ch: CHAR;
  152.     BEGIN 
  153.         NEW (g); 
  154.         DialogFrames.GetCaretPosition (p, x, y);
  155.         IF (p # NIL) THEN 
  156.             g.Init (); In.Open; Texts.OpenReader (r, Oberon.Par.text, 0); Texts.Read (r, ch);
  157.             In.Name (name);
  158.             IF ~In.Done THEN COPY ("", name); In.Open ELSE g.fnt := r.fnt END;
  159.             g.SetName (name); 
  160.             In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
  161.             IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
  162.             ELSE
  163.                 IF w < 0 THEN w := W END;
  164.                 IF h < 0 THEN h := H END
  165.             END;
  166.             g.SetDim (x1, y1, w, h, FALSE);
  167.             g.SetString (name); g.SetFont (Fonts.This ("Syntax10.Scn.Fnt")); 
  168.             p.Insert (g, TRUE);
  169.         ELSE
  170.             Dialogs.res := Dialogs.wrongInput
  171.         END;
  172.         IF Dialogs.res # 0 THEN 
  173.             Dialogs.Error ("DialogGroupBoxes") 
  174.         END;
  175.     END Insert;
  176.     PROCEDURE SetString*;
  177.     (** SetString ({ch} | ^) sets the string of the groupbox item at the caret to str *)
  178.         VAR o: Dialogs.Object; p: Dialogs.Panel; str: ARRAY 64 OF CHAR; ch: CHAR; i: INTEGER;
  179.     BEGIN 
  180.         In.Open; In.Char (ch); i := 0;
  181.         WHILE In.Done & (ch = " ") DO In.Char (ch) END; (* skip leading blanks *)
  182.         IF ~ In.Done THEN 
  183.             Dialogs.res := Dialogs.wrongInput
  184.         ELSE 
  185.             WHILE In.Done & (ch # CR) & (ch # "~") & (i < 63) DO str[i] := ch; INC (i); In.Char (ch) END; 
  186.             str[i] := 0X;
  187.             DialogFrames.FindObject (o, p);
  188.             IF (Dialogs.res = Dialogs.ok) & (o IS Item) THEN 
  189.                 o(Item).SetString (str); o(Item).SetFont (Fonts.This ("Syntax10.Scn.Fnt")) 
  190.             END 
  191.         END;
  192.         IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("DialogGroupBoxes") END
  193.     END SetString;
  194.     PROCEDURE GetString*;
  195.     (** writes the component s of the groupbox item under the caret to the log viewer *)
  196.         VAR o: Dialogs.Object; p: Dialogs.Panel; str: ARRAY 64 OF CHAR;
  197.     BEGIN
  198.         DialogFrames.FindObject (o, p);
  199.         IF Dialogs.res = Dialogs.ok THEN
  200.             IF o IS Item THEN
  201.                 COPY (o(Item).s, str);
  202.                 Texts.WriteString (w0, "String:"); Texts.WriteString (w0, str); Texts.WriteLn (w0);
  203.                 Texts.Append (Oberon.Log, w0.buf)
  204.             ELSE
  205.                 Dialogs.res := Dialogs.objectNotFound
  206.             END
  207.         END;
  208.         IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("DialogStaticTexts") END
  209.     END GetString;
  210. BEGIN Texts.OpenWriter (w0)
  211. END DialogGroupBoxes.
  212.